home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
ctlib100.zip
/
INSTALL.LZH
/
ARRAYS7.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-10-12
|
4KB
|
157 lines
{**************************************************************************}
{* BitSoft Development, L.L.C. *}
{* Copyright (C) 1995, 1996 BitSoft Development, L.L.C. *}
{* All rights reserved. *}
{* Containers Library demo *}
{**************************************************************************}
program Arrays7;
{$X+}
{ Sample program for using a standard sorted array }
uses Containr, ctArrays,
{$ifdef Windows}
WinCtr;
{$else}
Crt;
{$endif}
type
PContact = ^TContact;
TContact = record
FirstName : string[15];
LastName : string[20];
Phone : string[18];
Company : string [25];
end; { TContact }
type
PSortedContactList = ^TSortedContactList;
TSortedContactList = object(TSortedStdArray)
function KeyOf(Item : Pointer) : Pointer; virtual;
end; { TSortedContactList }
function TSortedContactList.KeyOf(Item : Pointer) : Pointer;
begin
KeyOf := @(PContact(Item)^.LastName);
end;
procedure SetContactValues(ALastName, AFirstName, APhone,
ACompany : string; var ContactRec : TContact);
begin
with ContactRec do
begin
FirstName := AFirstName;
LastName := ALastName;
Phone := APhone;
Company := ACompany;
end; { with }
end;
procedure DisplayContacts(ContactList : PSequence);
procedure PrintInfo (Item : Pointer); far;
begin
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
end;
begin
ContactList^.ForEach(@PrintInfo);
end;
procedure DisplayFirst(ContactList : PSequence);
var
Item : Pointer;
Index : LongInt;
begin
Item := ContactList^.First(Index);
Writeln('First item:');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
procedure DisplayLast(ContactList : PSequence);
var
Item : Pointer;
Index : LongInt;
begin
Item := ContactList^.Last(Index);
Writeln('Last item:');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
procedure FindLastName(ContactList : PSequence; LastName : string);
var
Item : Pointer;
Index : LongInt;
function MatchLastName (Item : Pointer): boolean; far;
begin
MatchLastName := (LastName = PContact(Item)^.LastName);
end;
begin
Item := ContactList^.FirstThat(@MatchLastName, Index);
Writeln('Item found with last name ''', LastName, ''':');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
var
ContactList : PSortedContactList;
Contact : TContact;
begin
ClrScr;
{ Create the array }
ContactList := New(PSortedContactList, Init(50, 10, SizeOf(TContact)));
{ Insert the items in the array }
with ContactList^ do
begin
SetContactValues('Lewis', 'Carl', '(506) 83-780', 'Running, Corp.',
Contact);
Insert(@Contact);
SetContactValues('Benton', 'Michael', '(403) 33-973', 'ER, Inc.',
Contact);
Insert(@Contact);
SetContactValues('Wagner', 'Robert', '(906) 11-230', 'Symphony, Ltd.',
Contact);
Insert(@Contact);
SetContactValues('Smith', 'John', '(656) 75-843', 'InterComm, Corp.',
Contact);
Insert(@Contact);
end; { with }
DisplayContacts(ContactList);
Writeln;
DisplayFirst(ContactList);
Writeln;
DisplayLast(ContactList);
Writeln;
FindLastName(ContactList, 'Wagner');
{ Dispose of the array }
Dispose(ContactList, Done);
end.